# Figure_A03.R

# Part of the replication archive for 
#
#   Bullock, John G. 2020. "Education and Attitudes toward Redistribution in
#   the United States." British Journal of Political Science 50.


# This file produces Figure A3 in the appendix to the article: "Education is 
# associated with increased opposition to redistribution."



library(Bullock, lib.loc = c(.libPaths(), 'packageLibrary'))  # for qw()
library(dplyr)    # for %>%
library(Hmisc)    # for Dotplot()
library(lattice)
library(grid)

source("IV_setup.R")
source('float_code/dotplotParameters.R')

outcomeInfo <- data.frame(
  varNames = qw('eqwlth goveqinc guarantee.7pt govt.health.7pt helppoor welfare'),
  dfNames  = qw('GSS.df GSS.df   ANES.df       ANES.df         GSS.df   GSS.df'),
  stringsAsFactors = FALSE) 

ANES.df$educ <- cut(
  x = ANES.df$educ, 
  breaks = c(-100, 7, 10, 12, 100),
  labels = qw('<8 8-10 11-12 >12'),
  ordered_result = TRUE)
GSS.df$educ <- cut(
  x = GSS.df$educ, 
  breaks = c(-100, 7, 10, 12, 100),
  labels = qw('<8 8-10 11-12 >12'),
  ordered_result = TRUE)



##############################################################################
# PRELIMINARIES FOR PRINTING THE FIGURE 
##############################################################################
dirOutput        <- 'float_output/'
filenameStem     <- 'Figure_A03' 
PDFtitle         <- 'Figure A3: Mean attitudes by level of education'
PS_width         <- 9.5
PS_height        <- 12.0
postscriptBackground <- 'transparent'
panelWidth       <- list(1.72, "inches")  
panelHeight      <- list(0.90, "inches")    
stripHeight      <- list(lines = 2.55, lineheight = 14) # lineheight is space between lines
plotLineColor    <- gray(.2)
plotLineWidth    <- 1
dotPlotLineColor <- gray(.5) 
panelBorderCol   <- gray(.2)
panelBorderWidth <- .3
panelLayout      <- c(3, 2)  # columns, then rows
xBetween         <- 0.90     # space between columns
yBetween         <- 3.30     # space between rows
baseCexSize      <- 1 
xLabSize         <- baseCexSize * .900
yLabSize         <- baseCexSize * .900
xAxisTextSize    <-  .8*.87  # cex
yAxisTextSize    <-  .8*.87  # cex
stripTextSize    <-  .700 * baseCexSize 
axisTickSize     <- .4

edAxisAt          <- 1:length(levels(GSS.df$educ))
edAxisTickLabels  <- c('<8 years', paste0('8\U00AD', '10 years'), paste0('11\U00AD', '12 years'), '>12 years')
edAxisLabel       <- 'level of schooling'
attAxisLimits     <- c(.3, .7)
attAxisTickLabels <- qw('.35 .45 .55 .65')
xAxis             <- list(
  draw        = TRUE, 
  labels      = attAxisTickLabels, 
  at          = as.numeric(attAxisTickLabels),
  limits      = attAxisLimits,
  tck         = c(axisTickSize, 0), 
  col         = panelBorderCol, 
  cex         = xAxisTextSize,
  alternating = 1, 
  relation    = 'free', 
  axs         = 'i')  # axs='i' means that there is no padding around the xlimits
yAxis            <- list(
  draw        = FALSE,
  labels      = edAxisTickLabels, 
  at          = edAxisAt,
  limits      = c(min(edAxisAt)-.5, max(edAxisAt)+.6),
  tck         = c(axisTickSize, 0),
  col         = panelBorderCol,
  cex         = yAxisTextSize,
  alternating = 1,
  relation    = 'same',  
  rot         = 0,
  axs         = 'i')



##############################################################################
# CREATE AND ORDER THE DATA FRAME
##############################################################################
attsByEducLevel.df <- expand.grid(
  edLevel = levels(GSS.df$educ),
  outcome = outcomeInfo$varNames,
  lower   = NA,
  mean    = NA,
  upper   = NA)
ANES.df$educInRange <- !is.na(ANES.df$educ) 
GSS.df$educInRange  <- !is.na(GSS.df$educ)  

goveqinc.tTest        <- tapply(GSS.df$goveqinc        [GSS.df$educInRange],  GSS.df$educ[GSS.df$educInRange],   t.test)
eqwlth.tTest          <- tapply(GSS.df$eqwlth          [GSS.df$educInRange],  GSS.df$educ[GSS.df$educInRange],   t.test)
guarantee.7pt.tTest   <- tapply(ANES.df$guarantee.7pt  [ANES.df$educInRange], ANES.df$educ[ANES.df$educInRange], t.test)
govt.health.7pt.tTest <- tapply(ANES.df$govt.health.7pt[ANES.df$educInRange], ANES.df$educ[ANES.df$educInRange], t.test)
helppoor.tTest        <- tapply(GSS.df$helppoor        [GSS.df$educInRange],  GSS.df$educ[GSS.df$educInRange],   t.test)
welfare.tTest         <- tapply(GSS.df$welfare         [GSS.df$educInRange],  GSS.df$educ[GSS.df$educInRange],   t.test)

attsByEducLevel.df$mean <- c(
  sapply(goveqinc.tTest,        function (x) x$estimate),
  sapply(eqwlth.tTest,          function (x) x$estimate),
  sapply(guarantee.7pt.tTest,   function (x) x$estimate),
  sapply(govt.health.7pt.tTest, function (x) x$estimate),
  sapply(helppoor.tTest,        function (x) x$estimate),
  sapply(welfare.tTest,         function (x) x$estimate))  
attsByEducLevel.df$lower <- c(
  sapply(goveqinc.tTest,        function (x) x$conf.int)[1,],
  sapply(eqwlth.tTest,          function (x) x$conf.int)[1,],
  sapply(guarantee.7pt.tTest,   function (x) x$conf.int)[1,],
  sapply(govt.health.7pt.tTest, function (x) x$conf.int)[1,],
  sapply(helppoor.tTest,        function (x) x$conf.int)[1,],
  sapply(welfare.tTest,         function (x) x$conf.int)[1,])  
attsByEducLevel.df$upper <- c(
  sapply(goveqinc.tTest,        function (x) x$conf.int)[2,],
  sapply(eqwlth.tTest,          function (x) x$conf.int)[2,],
  sapply(guarantee.7pt.tTest,   function (x) x$conf.int)[2,],
  sapply(govt.health.7pt.tTest, function (x) x$conf.int)[2,],
  sapply(helppoor.tTest,        function (x) x$conf.int)[2,],
  sapply(welfare.tTest,         function (x) x$conf.int)[2,])


# AUXILIARY RESULTS
if (interactive()) {
  attsByEducLevel.df %>%
    group_by(outcome) %>%
    summarise(x = mean[edLevel == '>12'] - mean[edLevel == '<8'])
  
  lNA(GSS.df$eqwlth[!is.na(GSS.df$educ)])
  lNA(GSS.df$goveqinc[!is.na(GSS.df$educ)])
  lNA(ANES.df$guarantee.7pt[!is.na(ANES.df$guarantee.7pt)])
  lNA(ANES.df$govt.health.7pt[!is.na(ANES.df$govt.health.7pt)])
  lNA(GSS.df$helppoor[!is.na(GSS.df$educ)])
  lNA(GSS.df$welfare[!is.na(GSS.df$educ)])
}



##############################################################################
# STRIP FUNCTION
##############################################################################
horizStrip <- function(...) {
  stripYCoords    <- c(0,0,1,1,0)
  stripTextYCoord <- .5 
  lpolygon(
    x        = c(0,1,1,0,0), 
    y        = stripYCoords, 
    col      = stripBackgroundCol, 
    border   = stripBorderCol,
    linejoin = 'mitre',  # for square corners
    lwd      = panelBorderWidth)
  ltext(
    x          = .5, 
    y          = stripTextYCoord, 
    labels     = stripText[panel.number()], 
    font       = 2, 
    cex        = stripTextSize, 
    lineheight = 1)  # .4 for one-line labels         
}  



##############################################################################
# PANEL FUNCTION
##############################################################################
descriptive_attsByEduc_panelFunction <- function(...) {
  trellis.par.set("clip", list(panel = "on", strip = "on")) 
  panel.Dotplot(...)
  
  # Put tick marks at top of each panel
  panel.axis(
    side        = "top",
    at          = xAxis$at,
    draw.labels = FALSE,
    half        = FALSE,
    tck         = axisTickSize * .75)
}



##############################################################################
# CREATE THE FIGURE
##############################################################################
# Clipping problems prevent me from doing most of the panel annotation in the 
# panel function, so I do it here instead.  
descriptive_theme <- list(
  axis.components = list(     # distance between axis ticks and tick labels
    left  = list(pad1 = .50),
    right = list(pad1 = .50)),  

  axis.line = list(           # panel border - to eliminate, set col to "white"
    alpha = 1, 
    col   = panelBorderCol, 
    lty   = 1, 
    lwd   = panelBorderWidth),

  clip = list(
    panel = "on", 
    strip = "on"),
  
  dot.line = list(            # background lines that span the panel
    alpha = 1, 
    col   = dotplotLineColor,  
    lty   = 1, 
    lwd   = 1),
  dot.symbol = list(
    alpha = 1, 
    cex   = .5, 
    col   = dotColor, 
    font  = 1, 
    pch   = 16),           
  plot.line = list(           # lines for confidence intervals
    alpha = 1, 
    col   = 'black', 
    lty   = 1, 
    lwd   = 1),
  superpose.line = list(
    col   = 'black')
)


# CREATE THE PLOT
descriptiveDotplots <- Dotplot(
  edLevel ~ Cbind(mean, lower, upper) | outcome, 
  data           = attsByEducLevel.df,
  panel          = descriptive_attsByEduc_panelFunction,
  layout         = panelLayout,
  as.table       = TRUE,
  between        = list(x = xBetween, y = yBetween),                   
  strip          = horizStrip,
  par.strip.text = stripHeight,
  scales         = list(x=xAxis, y=yAxis),
  xlab           = '',
  ylab           = '',
  par.settings   = descriptive_theme
)


# PRINT AND LABEL THE PLOT
# We need to print it before we can add labels.
print(
  descriptiveDotplots, 
  panel.width  = panelWidth, 
  panel.height = panelHeight)
for (panelNum in 1:6) {
  trellis.focus(
    name      = "panel", 
    column    = ifelse(panelNum<4, panelNum, panelNum - 3), 
    row       = ceiling(panelNum / 3), 
    clip.off  = TRUE, 
    highlight = FALSE)
  
  # Tick labels for y axis on left-hand panels
  panel.axis(
    side     = 'left', 
    at       = yAxis$at, 
    labels   = if (panelNum%in%c(1,4)) yAxis$labels else NULL,
    outside  = TRUE,
    half     = FALSE,
    tck      = 0,
    text.cex = yAxisTextSize)

  # Tick labels for y axis on right-hand panels
  panel.axis(
    side     = 'right', 
    at       = yAxis$at, 
    labels   = NULL,
    outside  = TRUE,
    half     = FALSE,
    tck      = 0,
    text.cex = yAxisTextSize)

  # Panel labels for x and y axis
  grid.text(
    label = 'average attitude', 
    x     = .5, 
    y     = -.39, 
    gp    = gpar(font=1, cex=xLabSize, col=panelBorderCol), 
    rot   = 0)
  grid.text(
    label = ifelse(panelNum%in%c(1,4), edAxisLabel, ''), 
    x     = -.500, 
    y     = .5, 
    gp    = gpar(font=1, cex=xLabSize, col=panelBorderCol), 
    rot   = 90)
  
  trellis.unfocus()
}
descriptiveDotplots_grob <- grid.grab(wrap = TRUE)



##############################################################################
# PRINT THE PDF FILE
##############################################################################
# When only one line is plotted per panel, plot.line governs the appearance of 
# the line.  When more than one line is plotted per panel, superpose.line 
# governs the appearance of the lines.
pdf(
  file   = paste0(dirOutput, filenameStem, '.pdf'), 
  width  = PS_width, 
  height = PS_height, 
  paper  = "special", 
  title  = PDFtitle,
  bg     = postscriptBackground)

grid.draw(descriptiveDotplots_grob)

dev.off()

if (!(Sys.which('pdfcrop')=='' | Sys.which('perl')=='')  |  'pdfcrop' %in% installed.packages()[, 'Package']) {  # if "pdfcrop" is installed 
  system(paste(
    if (Sys.info()['sysname']=='Windows') paste(Sys.getenv('Comspec'), '/c ') else '',
    'pdfcrop', 
    paste0(dirOutput, filenameStem, '.pdf'), 
    paste0(dirOutput, filenameStem, '_crop.pdf')))
  file.remove(paste0(dirOutput, filenameStem, '.pdf'))
  if (interactive()) paste0(
      normalizePath(dirOutput), 
      filenameStem, 
      '_crop.pdf') %>%
    shell.exec
}